home *** CD-ROM | disk | FTP | other *** search
/ The Business Master (3rd Edition) / The Business Master (3rd Edition).iso / files / commadio / mapper3 / hmapper.arc / MAPPER3.BAS < prev    next >
BASIC Source File  |  1988-01-22  |  33KB  |  639 lines
  1. 100 DEFINT I-N:COLOR 2,0
  2. 110 DIM LEGEND$(10),MENU$(20),MONTH$(12),XDAT(5),YDAT(5),X(1000),Y(1000),XS(400),YS(400),XI(3),XT(3),XU(3),PREFIX$(20),COUNTRY$(20),XLAT(20),XLONG(20)
  3. 120 DIM FREQ(10),WAVE.LEN(10),TX.LOSS(10),RX.LOSS(10),REF.LOSS(10),ABSORB.LOSS(10),PR(10)
  4. 125 DIM GT(10),GR(10),H.TXANT(10),H.RXANT(10),TX.POL$(10),RX.POL$(10),TX.POL%(10),RX.POL%(10)
  5. 130 DATA Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec
  6. 140 FOR I=0 TO 11:READ MONTH$(I):NEXT
  7. 150 DATA "    Menu Options     ","                     ","1*-Select DX Prefix  ","2- Specify Country Name","3- Specify Lat/Lon   ","4- Change Sunspot #  "
  8. 160 DATA "5- Select Date/Time  ","6- Use Real Time     ","7- Select Short Path ","8- Select Long  Path ","9- Quit              "
  9. 170 DATA "                     ","   Choose One "
  10. 180 N.MENU=13:FOR I=1 TO N.MENU:READ MENU$(I):NEXT I
  11. 190 DATA 3.5,7,10.1,14,18.1,21,24.5,28.5:NFREQ=8
  12. 200 FOR I=1 TO NFREQ:READ FREQ(I):WAVE.LEN(I)=300/FREQ(I):NEXT I
  13. 210 DATA Prfx,Ctry,Lat/Lon,Dat/Tim,R Time,ShPth,LngPth,ChParams,Quit
  14. 220 FOR I=1 TO 9:READ LEGEND$(I):NEXT I
  15. 230 '$DYNAMIC
  16. 240 DIM NSTORE(32500),ZPREFIX$(500),ZCOUNTRY$(500),ZLAT(500),ZLONG(500)
  17. 250 '$STATIC
  18. 300 DEF FNASIN(X)
  19. 310    IF ABS(X)>=.999999 THEN FNASIN=SGN(X)*2*ATN(1):EXIT DEF
  20. 320    FNASIN=ATN(X/SQR(1-X*X))
  21. 330 END DEF
  22. 340 DEF FNACOS(X)
  23. 350    FNACOS=2*ATN(1)-FNASIN(X)
  24. 360 END DEF
  25. 370 DEF FNATN2(X,Y)
  26. 380    IF ABS(X)<.00001 THEN FNATN2=SGN(Y)*2*ATN(1):EXIT DEF
  27. 390    IF ABS(Y)<.00001 THEN FNATN2=2*ATN(1)*(1-SGN(X)):EXIT DEF
  28. 400    IF Y>=0 AND X>0 THEN FNATN2=ATN(Y/X):EXIT DEF
  29. 410    IF Y>=0 AND X<0 THEN FNATN2=2*ATN(1)-ATN(X/Y):EXIT DEF
  30. 420    IF X>0 THEN FNATN2=ATN(Y/X):EXIT DEF
  31. 430    FNATN2=-2*ATN(1)-ATN(X/Y)
  32. 440 END DEF
  33. 450  DEF FNT.MOD(T,T0)= T-.5*T0*(1+SGN(T-T0))*SGN(ABS(T-T0))
  34. 460  DEF FNXFORM(X)
  35. 470      XFORM=X-HOME.LON:IF XFORM>180 THEN XFORM=XFORM-360
  36. 480      IF XFORM<-180 THEN XFORM=360+XFORM
  37. 490      FNXFORM=XFORM
  38. 500 END DEF
  39. 510 DEF FNDIG$(X)
  40. 520 KX=X:AA$=MID$(STR$(KX),2):FNDIG$=AA$:IF LEN(AA$)=1 THEN FNDIG$="0"+AA$
  41. 530 END DEF
  42. 540 DEF FNDB(X)=10*LOG(X)/LOG(10)
  43. 550 DEF FNDBI(X)=10^(.1*X)
  44. 660 DEF FNSUN.SPOT(SF) : REM   CALCULATION OF SUNSPOT NUMBER FROM SOLAR FLUX
  45. 670 IF SF>0 THEN FNSUN.SPOT=SF:EXIT DEF
  46. 680 SF=ABS(SF)
  47. 690 SSQ = -103.7767 + 1.797429 * SF - (3.384356E-03) * SF ^ 2 + (4.525515E-06) * SF ^ 3
  48. 700 FNSUN.SPOT= INT(100 * SSQ + .5) / 100
  49. 710 END DEF
  50.  
  51. 800 PI=4*ATN(1):CNV=180/PI:RE=6364
  52. 810 T.DRAW=20
  53. 820 'CALL CLOCKON(0)
  54. 830 ON KEY(1) GOSUB 11000:ON KEY(2) GOSUB 11010:ON KEY(3) GOSUB 11020:ON KEY(4) GOSUB 11030:
  55. 840 ON KEY(5) GOSUB 11040:ON KEY(6) GOSUB 11050:ON KEY(7) GOSUB 11060:ON KEY(8) GOSUB 11070:ON KEY(9) GOSUB 11080
  56. 1000 PRINT:PRINT
  57. 1010 PRINT "               DX Mapping and HF Propagation Prediction  Program        "
  58. 1020 PRINT "                         Adapted from MINIMUF 3.5 "
  59. 1030 PRINT "                            by Dennis Murray        "
  60. 1040 PRINT :PRINT
  61. 1050 PRINT "          This program is in the Public Domain for non-commercial   "
  62. 1060 PRINT "          use only by anyone who wants to use it or adapt it to
  63. 1070 PRINT "          suit their needs. The author takes no responsibility for "
  64. 1080 PRINT "          guaranteeing that it will work on your machine, nor for "
  65. 1090 PRINT "          supporting this software. It works on AT-compatible machines"
  66. 1100 PRINT "          and requires an EGA Graphics Adapter with color display "
  67. 1110 PRINT "          capable of using BASIC screen mode 9 (640x350 16 color )."
  68. 1120 PRINT "          Modification of the source code will be necessary to make it"
  69. 1130 PRINT "          run in other graphics modes. It is designed to be compiled"
  70. 1140 PRINT "          using Microsoft Quick Basic v2.0 or later, but it can be "
  71. 1150 PRINT "          compiled using Borland Turbo Basic also. "
  72. 1160 PRINT :PRINT
  73. 1170 PRINT "          You are on your own if it doesn't work on your machine!"
  74. 1180 PRINT "                  ( What do you want for free? )"
  75. 1190 PRINT:PRINT "                     Hit any key to proceed";:A$=INPUT$(1):CLS
  76. 1500 'READ ATLAS
  77. 1510 PRINT :LOCATE 13,16,0:COLOR 20,14,0:PRINT " Fetching DX Atlas  .. Wait a While ";
  78. 1520 OPEN "I",2,"MAPPER.ATL" :K=0
  79. 1530 IF EOF(2 ) THEN N.ATL=K:CLOSE 2:GOTO 1600
  80. 1540 K=K+1:INPUT #2,ZPREFIX$(K),ZLAT(K),ZLONG(K),ZCOUNTRY$(K)
  81. 1550 GOTO 1530
  82. 1600 COLOR 2,0:CLS:PRINT:PRINT
  83. 1610 PRINT USING "             ### DX Atlas Entries Loaded";N.ATL:PRINT
  84. 1620 PRINT
  85. 2000 OPEN "I",2,"MAPPER.DEF" :INPUT #2,HOME.LAT,HOME.LON,SSN,T.DRAW
  86. 2010 FOR I=1 TO NFREQ:INPUT #2,H.TXANT(I),TX.POL$(I),GT(I):NEXT I
  87. 2020 FOR I=1 TO NFREQ:INPUT #2,H.RXANT(I),RX.POL$(I),GR(I):NEXT I
  88. 2030 INPUT #2,PT,E.MIN:CLOSE 2
  89. 2040 SCREEN 9 :COLOR 2
  90. 2050 'RENTRY POINT
  91. 2060 CLS 0  :COLOR 2
  92. 2070 PRINT       "   Default Values Which Will Be Used Unless Changed"
  93. 2080 PRINT:
  94. 2090 PRINT USING "     1- Sunspot Number = ###        ";SSN
  95. 2100 PRINT USING "     2- Home Latitude/Longitude = ###.# N / ####.# W";HOME.LAT,-HOME.LON
  96. 2110 PRINT USING "     3- Auto Redraw of Solar Terminator Every ### min";T.DRAW
  97. 2112 PRINT USING "     4- Home Transmitter Power Output=#### Watts";PT
  98. 2114 PRINT USING "     5- Minimum Elevation Angle=###.# deg";E.MIN
  99. 2120 PRINT       "     6- Home Antenna .."
  100. 2122 PRINT "Band Freq(MHz) Ht(ft) Pol  Gain(dBi) .. Band Freq(MHz) Ht(ft) Pol  Gain(dBi)"
  101. 2125 FOR I=1 TO NFREQ/2
  102. 2126 PRINT USING " ##    ##.#    ###.#  \   \   ###.#      ##    ##.#    ###.#  \   \   ###.#";I,FREQ(I),H.TXANT(I)*3.28,TX.POL$(I),GT(I),I+NFREQ/2,FREQ(I+NFREQ/2),H.TXANT(I+NFREQ/2)*3.28,TX.POL$(I+NFREQ/2),GT(I+NFREQ/2)
  103. 2127 NEXT I
  104. 2130 PRINT       "     7- DX   Antenna .."
  105. 2132 PRINT "Band Freq(MHz) Ht(ft) Pol  Gain(dBi) .. Band Freq(MHz) Ht(ft) Pol  Gain(dBi)"
  106. 2135 FOR I=1 TO NFREQ/2
  107. 2136 PRINT USING " ##    ##.#    ###.#  \   \   ###.#      ##    ##.#    ###.#  \   \   ###.#";I,FREQ(I),H.RXANT(I)*3.28,RX.POL$(I),GR(I),I+NFREQ/2,FREQ(I+NFREQ/2),H.RXANT(I+NFREQ/2)*3.28,RX.POL$(I+NFREQ/2),GR(I+NFREQ/2)
  108. 2137 NEXT I
  109. 2160 PRINT
  110. 2170 PRINT       "   Enter (1-7) to change ... Anything else to accept";
  111. 2180 A$=INPUT$(1):N=VAL(A$):PRINT :PRINT
  112. 2190 IF N = 1 THEN INPUT "Enter New Sunspot Number (negative for Solar Flux)"; SF:SSN=FNSUN.SPOT(SF): CLS : GOTO 2050
  113. 2200 IF N=3 THEN INPUT "Enter Auto Redraw Interval (Minutes)";T.DRAW:CLS:GOTO 2050
  114. 2210 IF N=6 THEN INPUT "Enter Band #,  Home Ant Ht (ft), Pol (H/V), and Gain (dBi)";I,H.TXANT(I),TX.POL$(I),GT(I):H.TXANT(I)=H.TXANT(I)/3.28
  115. 2215 IF N=6 THEN A$=LEFT$(TX.POL$(I),1):IF A$="H" OR A$="h" THEN TX.POL$(I)="Hor":CLS:GOTO 2050 ELSE TX.POL$(I)="Vert":CLS:GOTO 2050
  116. 2220 IF N=7 THEN INPUT "Enter Band #,  DX   Ant Ht (ft), Pol (H/V), and Gain (dBi)";I,H.RXANT(I),RX.POL$(I),GR(I):H.RXANT(I)=H.RXANT(I)/3.28
  117. 2225 IF N=7 THEN A$=LEFT$(RX.POL$(I),1):IF A$="H" OR A$="h" THEN RX.POL$(I)="Hor":CLS:GOTO 2050 ELSE RX.POL$(I)="Vert":CLS:GOTO 2050
  118. 2230 IF N=4 THEN INPUT "Enter Home Transmit Power Output (W)";PT:CLS:GOTO 2050
  119. 2240 IF N=5 THEN INPUT "Enter Min Elevation Launch Angle (deg)";E.MIN:CLS:GOTO 2050
  120. 2250 IF N<>2 THEN 3000
  121. 2260 INPUT "Enter Home Lat/Lon (+ For North Lat and West Lon) ";HOME.LAT,HOME.LON:HOME.LON=-HOME.LON
  122. 2270 HOME.LON=HOME.LON MOD 360:IF HOME.LON>180 THEN HOME.LON=HOME.LON-360
  123. 2280 IF HOME.LON<-180 THEN HOME.LON=360+HOME.LON
  124. 2290 CLS :MAP.FLAG%=-1:GOTO 2050
  125. 3000 OPEN "O",2,"MAPPER.DEF":
  126. 3010 PRINT #2,HOME.LAT,HOME.LON,SSN,T.DRAW
  127. 3020 FOR I=1 TO NFREQ:PRINT #2,H.TXANT(I);",",TX.POL$(I);",",GT(I):NEXT I
  128. 3030 FOR I=1 TO NFREQ:PRINT #2,H.RXANT(I);",",RX.POL$(I);",",GR(I):NEXT I
  129. 3040 PRINT #2,PT;",",E.MIN
  130. 3050 CLOSE 2 :CLS 0
  131. 3060 FOR I=1 TO NFREQ
  132. 3065 IF LEFT$(TX.POL$(I),1)="V" THEN TX.POL%(I)=-1
  133. 3070 IF LEFT$(RX.POL$(I),1)="V" THEN RX.POL%(I)=-1
  134. 3075 NEXT I
  135. 3080 ON TIMER(60*T.DRAW) GOSUB REDRAW
  136. 3090 IF MAP.FLAG% THEN GOSUB LAT.LON.SCRN:GOSUB FETCH.MAP :GOTO RESTORE.SCREEN
  137. 3100 NSEG=VARSEG(NSTORE(0)):NOFF=VARPTR(NSTORE(0))
  138. 3120 DEF SEG=NSEG:BLOAD "MAPPER.SCR",NOFF:DEF SEG
  139. 3500 RESTORE.SCREEN:
  140. 3510 TIMER ON
  141. 3520 GOSUB GET.DATE:GOSUB LAT.LON.SCRN
  142. 3530 CLS:PAINT (0,0),0,7
  143. 3540 GOSUB DRAW.TERMINATOR
  144. 3550 PUT (XBEGIN,YBEGIN),NSTORE,OR
  145. 3560 GOSUB PAINT.OCEANS
  146. 3570 GOSUB DRAW.LAT.LON
  147. 3580 LOCATE 25,1:FOR I=1 TO 9:COLOR 2:PRINT " F"+CHR$(48+I);:COLOR 14:PRINT LEGEND$(I);:NEXT I
  148. 4000 MENU:
  149. 4010 FOR I=1 TO 9:KEY(I) ON:NEXT I
  150. 4020 A$=INKEY$:IF A$="" THEN 4020
  151. 4030 FOR I=1 TO 9:KEY(I) OFF:NEXT I
  152. 4040 ON OP% GOTO 4100,4200,4300,4500,4600,4700,4800,4400,4900
  153. 4100 'LOCATION BY PREFIX
  154. 4110 GOSUB GET.PREFIX  :IF K>0 THEN GOTO PATH.CALCULATION
  155. 4120 GOSUB DELAY:GOTO MENU
  156. 4200 'LOCATION BY COUNTRY NAME
  157. 4210 GOSUB GET.COUNTRY  :IF K>0 THEN GOTO PATH.CALCULATION
  158. 4220 GOSUB DELAY:GOTO MENU
  159. 4300 'LAT/LON
  160. 4310 GOSUB CLEAR.TEXT:PRINT "Enter DX Lat/Long "
  161. 4320 INPUT XLAT,XLONG:XLONG=-XLONG:K=1:XLAT(1)=XLAT:XLONG(1)=XLONG
  162. 4330 PREFIX$(1)="":COUNTRY$(1)="Lat= "+STR$(XLAT)+" .. Long= "+STR$(-XLONG)
  163. 4340 GOTO 5010
  164. 4400 'NEW SSN
  165. 4405 CLS 0:GOTO 2000
  166. 4410 GOSUB CLEAR.TEXT:INPUT "Enter Sunspot Num ";SSN:GOSUB 9220:GOTO MENU
  167. 4500 'NEW DATE
  168. 4510 TIMER OFF:GOSUB CLEAR.TEXT:GOSUB GET.NEW.DATE:GOTO 3530
  169. 4600 'REAL TIME MODE
  170. 4610 GOTO RESTORE.SCREEN
  171. 4700 'SET SHORT PATH
  172. 4710 PATH%=0:GOTO MENU:
  173. 4800 'SET LONG PATH
  174. 4810 PATH%=-1:GOTO MENU
  175. 4900 END
  176. 5000 PATH.CALCULATION:
  177. 5010 XLAT=XLAT(K):XLONG=XLONG(K):
  178. 5020 LOCATE 1,26:PRINT SPACE$(54);:LOCATE 1,26
  179. 5030 COLOR 14:A$=LEFT$(" "+PREFIX$(K)+"  "+COUNTRY$(K),48)+" ":L=LEN(A$):B$=A$:IF L< 48 THEN B$=" "+STRING$(47,"*")+" ":MID$(B$,(49-L)/2)=A$
  180. 5040 PRINT B$;:EXTRA%=0
  181. 5050 CALL MINIMUF(HOME.LAT,HOME.LON,XLAT,XLONG,PATH%,M0+1,D0,T0,SSN,NHOPS,EXTRA%,F.MUF,F.LUF,E.CUTOFF)
  182. 5060 LOCATE 2,26:PRINT SPACE$(54):LOCATE 2,26
  183. 5070 PRINT USING "Fmuf=##.# Fluf=##.# F-Ecof=##.# MHz ## Hops";F.MUF,F.LUF,E.CUTOFF,NHOPS
  184. 5080 CALL TRANSFORM(XLAT,XLONG,X,Y,-1)
  185. 5090 IF PATH% THEN PATH$="Long " ELSE PATH$="Short"
  186. 5100 LOCATE 1,1:PRINT USING "Predicting \   \ Path to";PATH$
  187. 5110 RNG=SQR(X^2+Y^2)*PI*RE:IF PATH% THEN RNG=2*PI*RE-RNG:X=-X:Y=-Y
  188. 5120 AZIM=FNATN2(Y,X)*CNV
  189. 5130 IF AZIM<0 THEN AZIM=360+AZIM
  190. 5140 LOCATE 2,1:PRINT SPACE$(24);:LOCATE 2,1
  191. 5150 PRINT USING"Range=#####km,#####nm";RNG,RNG/1.85;
  192. 5160 LOCATE 3,1:PRINT SPACE$(24);:LOCATE 3,1
  193. 5170 PRINT USING "Az=#### El=###.# deg";AZIM,ELEV;:COLOR 2
  194. 5180 GOSUB PRINT.STRENGTH
  195. 5190 CLAT=COS(XLAT/CNV):SLAT=SIN(XLAT/CNV)
  196. 5200 XLONG=FNXFORM(XLONG)
  197. 5210 CLONG=COS(XLONG/CNV):SLONG=SIN(XLONG/CNV)
  198. 5220 XT(1)=CLAT*CLONG:XT(2)=CLAT*SLONG:XT(3)=SLAT
  199. 5230 XI(1)=COS(HOME.LAT/CNV):XI(2)=0:XI(3)=SIN(HOME.LAT/CNV)
  200. 5240 IF ERASE.FLAG% THEN NCOLOR =2:CALL MYLINE(NCOLOR,X(),Y(),IPTS,XDAT(),YDAT())
  201. 5250 IPTS=101:IF PATH% THEN DPATH=-270/(CNV*(IPTS-1)) ELSE DPATH=90/(CNV*(IPTS-1))
  202. 5260 J=0:FOR JJ=1 TO IPTS:RHO=COS((JJ-1)*DPATH):RHO1=SIN((JJ-1)*DPATH)
  203. 5270 SUM=0:FOR K=0 TO 3:XU(K)=XT(K)*RHO1+XI(K)*RHO:SUM=SUM+XU(K)^2:NEXT K
  204. 5280 SUM=SQR(SUM):FOR K=1 TO 3:XU(K)=XU(K)/SUM:NEXT K
  205. 5290 J=J+1:Y(J)=CNV*ATN(XU(3)/SQR(XU(1)^2+XU(2)^2))
  206. 5300 XU(1)=XU(1)/COS(Y(J)/CNV):XU(2)=XU(2)/COS(Y(J)/CNV)
  207. 5310 IF XU(1)<> 0 THEN X(J)=CNV*ATN(XU(2)/XU(1)) ELSE X(J)=90*SGN(XU(2))
  208. 5320 IF XU(1)<0 THEN IF X(J)<0 THEN X(J)=180+X(J) ELSE X(J)=-180+X(J)
  209. 5330 NEXT JJ:ERASE.FLAG%=-1:CALL MYLINE(14,X(),Y(),IPTS,XDAT(),YDAT())
  210. 5340 GOTO MENU
  211. 6000 GET.PREFIX: 'FETCH COUNTRY DATA
  212. 6010 COLOR 2:
  213. 6020 GOSUB CLEAR.TEXT
  214. 6030 INPUT "Enter DX Prefix";PF$ :L2=LEN(PF$):CALL UPPER.CASE(PF$)
  215. 6040 LOCATE 5,1:PRINT SPACE$(24);:LOCATE 5,1:JP=0
  216. 6050 K=1
  217. 6060 IF JP>N.ATL THEN GOTO 6120
  218. 6070 JP=JP+1:PREFIX$(K)=ZPREFIX$(JP):COUNTRY$(K)=ZCOUNTRY$(JP):XLAT(K)=ZLAT(JP):XLONG(K)=ZLONG(JP)
  219. 6080 L1=LEN(PREFIX$(K)):A$=PF$:IF L2>L1 THEN A$=LEFT$(A$,L1)
  220. 6090 IF INSTR(PREFIX$(K),A$)=0 THEN 6060
  221. 6100 PRINT USING "## ";K;:PRINT LEFT$(PREFIX$(K)+"  "+COUNTRY$(K),20):K=K+1
  222. 6110 IF K<18 THEN 6060
  223. 6120 PRINT :IF K=1  THEN PRINT PF$ +" Not Found   ";:K=-1:RETURN
  224. 6130 INPUT "Select one ";K
  225. 6140 IF K=0 THEN K=1:IF JP=N.ATL THEN PRINT PF$ +" Not Found   ";:K=-1:RETURN ELSE GOSUB CLEAR.TEXT:GOTO 6060
  226. 6150 GOSUB CLEAR.TEXT
  227. 6160 XLONG(K)=-XLONG(K):RETURN
  228. 7000 GET.COUNTRY: 'FETCH COUNTRY DATA
  229. 7010 COLOR 2:
  230. 7020 GOSUB CLEAR.TEXT
  231. 7030 PRINT "Enter Country Name ":INPUT CTY$ :L2=LEN(CTY$):CALL UPPER.CASE(CTY$)
  232. 7040 LOCATE 5,1:PRINT SPACE$(24);:LOCATE 6,1:PRINT SPACE$(24);:LOCATE 5,1:JP=0
  233. 7050 K=1
  234. 7060 IF JP>N.ATL THEN GOTO 7130
  235. 7070 JP=JP+1:PREFIX$(K)=ZPREFIX$(JP):COUNTRY$(K)=ZCOUNTRY$(JP):XLAT(K)=ZLAT(JP):XLONG(K)=ZLONG(JP)
  236. 7080 L1=LEN(COUNTRY$(K)):A$=CTY$:IF L2>L1 THEN A$=LEFT$(A$,L1)
  237. 7090 COUNTRY$=COUNTRY$(K):CALL UPPER.CASE(COUNTRY$)
  238. 7100 IF INSTR(COUNTRY$,A$)=0 THEN 7060
  239. 7110 PRINT USING "## ";K;:PRINT LEFT$(PREFIX$(K)+"  "+COUNTRY$(K),20):K=K+1
  240. 7120 IF K<18 THEN 7060
  241. 7130 PRINT :IF K=1  THEN PRINT CTY$ +" Not Found   ";:K=-1:RETURN
  242. 7140 INPUT "Select one ";K
  243. 7150 IF K=0 THEN K=1:IF JP=N.ATL THEN PRINT CTY$ +" Not Found   ";:K=-1:RETURN ELSE GOSUB CLEAR.TEXT:GOTO 7060
  244. 7160 GOSUB CLEAR.TEXT
  245. 7170 XLONG(K)=-XLONG(K):RETURN
  246. 8000 PAINT.OCEANS: 'PAINT OCEANS
  247. 8010 NCOLOR=7
  248. 8020 PAINT (FNXFORM(6),0),     1,7      'PAINT OCEANS BLUE
  249. 8030 PAINT (FNXFORM(45),-5),   1,7      'PAINT OCEANS BLUE
  250. 8040 PAINT (FNXFORM(60),0),    1,7      'PAINT OCEANS BLUE
  251. 8050 PAINT (FNXFORM(75),0),    1,7      'PAINT OCEANS BLUE
  252. 8060 PAINT (FNXFORM(90),0),    1,7      'PAINT OCEANS BLUE
  253. 8070 PAINT (FNXFORM(105),-15), 1,7      'PAINT OCEANS BLUE
  254. 8080 PAINT (FNXFORM(120),-15), 1,7      'PAINT OCEANS BLUE
  255. 8090 PAINT (FNXFORM(135),15),  1,7      'PAINT OCEANS BLUE
  256. 8100 PAINT (FNXFORM(150),0),   1,7      'PAINT OCEANS BLUE
  257. 8110 PAINT (FNXFORM(180),88),  1,7      'PAINT OCEANS BLUE
  258. 8120 PAINT (FNXFORM(90),88),   1,7      'PAINT OCEANS BLUE
  259. 8130 PAINT (FNXFORM(0),88),    1,7      'PAINT OCEANS BLUE
  260. 8140 PAINT (FNXFORM(-90),88),  1,7      'PAINT OCEANS BLUE
  261. 8150 PAINT (FNXFORM(-180),88), 1,7      'PAINT OCEANS BLUE
  262. 8160 PAINT (FNXFORM(165),0),   1,7      'PAINT OCEANS BLUE
  263. 8170 PAINT (FNXFORM(180),0),   1,7      'PAINT OCEANS BLUE
  264. 8180 PAINT (FNXFORM(-165),0),  1,7      'PAINT OCEANS BLUE
  265. 8190 PAINT (FNXFORM(-150),0),  1,7      'PAINT OCEANS BLUE
  266. 8200 PAINT (FNXFORM(-135),0),  1,7      'PAINT OCEANS BLUE
  267. 8210 PAINT (FNXFORM(-120),0),  1,7      'PAINT OCEANS BLUE
  268. 8220 PAINT (FNXFORM(-105),0),  1,7      'PAINT OCEANS BLUE
  269. 8230 PAINT (FNXFORM(-90),0),   1,7      'PAINT OCEANS BLUE
  270. 8240 PAINT (FNXFORM(-45),5),   1,7      'PAINT OCEANS BLUE
  271. 8250 PAINT (FNXFORM(-30),0),   1,7      'PAINT OCEANS BLUE
  272. 8260 PAINT (FNXFORM(-15),0),   1,7      'PAINT OCEANS BLUE
  273. 8270 PAINT (FNXFORM(58),-5),   1,7      'PAINT OCEANS BLUE
  274. 8280 PAINT (FNXFORM(-124),34), 1,7      'PAINT OCEANS BLUE
  275. 8290 PAINT (FNXFORM(-70),32),  1,7      'PAINT OCEANS BLUE
  276. 8300 PAINT (FNXFORM(5),40),    1,7      'PAINT MED SEA BLUE
  277. 8310 PAINT (FNXFORM(-95),45),  2,7      'PAINT USA YELLOW
  278. 8320 PAINT (FNXFORM(-120),42), 2,7      'PAINT USA YELLOW
  279. 8330 PAINT (FNXFORM(-76),42),  2,7      'PAINT USA YELLOW
  280. 8340 PAINT (FNXFORM(-150),65), 2,7      'PAINT ALASKA YELLOW
  281. 8350 PAINT (FNXFORM(51.5),43), 1,7      'CASPIAN SEA
  282. 8360 PAINT (FNXFORM(-90),60),  1,7      'HUDSONS BAY
  283. 8370 PAINT (FNXFORM(-90),23),  1,7      'GULF OF MEXICO
  284. 8380 RETURN
  285. 8500 DRAW.LAT.LON: 'DRAW LAT/LON LINES
  286. 8510 FOR XLAT=-90 TO 90 STEP 30
  287. 8520 LINE (-180,XLAT)-(180,XLAT),6:NEXT
  288. 8530 FOR XLON=-180 TO 180 STEP 60
  289. 8540 LINE (XLON,-90)-(XLON,90),6:NEXT
  290. 8550 RETURN
  291. 9000 DRAW.TERMINATOR: 'CALCULATE TERMINATOR
  292. 9010 M0=VAL(D$)-1:D0=VAL(MID$(D$,4)):T0=VAL(T$)+VAL(MID$(T$,4))/60
  293. 9020 D0$=FNDIG$(D0):H0$=FNDIG$(INT(T0)):M0$=FNDIG$(60*(T0-INT(T0)))
  294. 9030 YR.ANG=.0172*(10+30.4*M0+D0):TILT=-.409*COS(YR.ANG)
  295. 9040 T.NOON=12+.13*SIN(YR.ANG)+.156*SIN(2*YR.ANG)
  296. 9050 IF M0+1>=4 AND M0+1<=10 THEN T.NOON=T.NOON+1 'DAYLIGHT SAVINGS TIME
  297. 9060 DT=-2*PI*(T0-T.NOON)/24 +HOME.LON/CNV
  298. 9070 CP=COS(TILT):SP=SIN(TILT):CD=COS(DT):SD=SIN(DT)
  299. 9080 LL=0:FOR L=1 TO 363:XL=L:CL=COS(XL/CNV):SL=SIN(XL/CNV)
  300. 9090 X1=-(SP*CD*CL+SD*SL)
  301. 9100 Y1=-(SP*SD*CL-CD*SL)
  302. 9110 Z1=CP*CL
  303. 9120 LL=LL+1:XS(LL)=CNV*FNASIN(Z1):YS0=CNV*FNATN2(X1,Y1):YS(LL)=YS0-HOME.LON
  304. 9130 YSS=360*SGN(YS(LL)):IF ABS(YS(LL))>180 THEN YS(LL)=YS(LL)-YSS
  305. 9140 IF LL>1 AND ABS(YS(LL)-YS(LL-1))>60 THEN GOSUB 9260
  306. 9150 NEXT L
  307. 9160 CALL MYLINE(7,YS(),XS(),LL,XDAT(),YDAT())
  308. 9170 X1=CP*CD:Y1=CP*SD:Z1=-SP
  309. 9180 X2=CNV*FNASIN(Z1):Y2=CNV*FNATN2(X1,Y1)-HOME.LON
  310. 9190 IF ABS(Y2)>180 THEN Y2=Y2-360*SGN(Y2)
  311. 9200 IF ABS(Y2)>178 THEN Y2=178*SGN(Y2)
  312. 9205 LINE (-179.5,-89.5) -(179.5,89.5),7,B
  313. 9210 PAINT (Y2,X2),4,7
  314. 9220 COLOR 14:LOCATE 3,1:PRINT SPACE$(79);:LOCATE 3,26:
  315. 9230 PRINT USING "\\ \  \ \\:\\ Local .. Sunspot Number = ####";D0$,MONTH$(M0),H0$,M0$,SSN;
  316. 9240 COLOR 2
  317. 9250 RETURN
  318. 9260 YS=YS(LL):YSS=185*SGN(YS(LL-1)):YS(LL)=YSS:CALL MYLINE(7,YS(),XS(),LL,XDAT(),YDAT())
  319. 9270 YS(1)=185*SGN(YS):YS(2)=YS:
  320. 9280 XS(1)=XS(LL):XS(2)=XS(LL):LL=2 :RETURN
  321. 10000 SUB TRANSFORM(X0,Y0,X2,Y2,POLAR%) STATIC
  322. 10010  STATIC CT0,ST0,NFLAG
  323. 10020 SHARED CNV,PI,HOME.LAT,HOME.LON
  324. 10030  IF NOT NFLAG THEN GOTO INITIALIZE
  325. 10040 NORMAL:
  326. 10050  X=X0:Y=Y0
  327. 10060  Y=FNXFORM(Y):IF NOT POLAR% THEN X2=X:Y2=Y:EXIT SUB
  328. 10070  CT=COS(X/CNV):ST=SIN(X/CNV):CP=COS(Y/CNV):SP=SIN(Y/CNV)
  329. 10080  X1=CT0*ST-ST0*CT*CP
  330. 10090  Y1=CT*SP:Z1=ST0*ST+CT0*CT*CP
  331. 10100  LAM!=FNACOS(Z1):PSI=FNATN2(X1,Y1)
  332. 10110  R=LAM!/PI:X2=R*SIN(PSI):Y2=R*COS(PSI)
  333. 10120  EXIT SUB
  334. 10130 INITIALIZE:
  335. 10140  CT0=COS(HOME.LAT/CNV):ST0=SIN(HOME.LAT/CNV)
  336. 10150  NFLAG=-1:GOTO NORMAL
  337. 10160 END SUB
  338. 11000 OP%=1:RETURN 4030
  339. 11010 OP%=2:RETURN 4030
  340. 11020 OP%=3:RETURN 4030
  341. 11030 OP%=4:RETURN 4030
  342. 11040 OP%=5:RETURN 4030
  343. 11050 OP%=6:RETURN 4030
  344. 11060 OP%=7:RETURN 4030
  345. 11070 OP%=8:RETURN 4030
  346. 11080 OP%=9:RETURN 4030
  347. 12000 FETCH.MAP: 'WORLD MAP DATA INPUT
  348. 12010 OPEN "I",1,"WORLDMAP.DAT":
  349. 12020 INPUT #1,X,Y :J=1
  350. 12030 I=0
  351. 12040 INPUT #1,X,Y  :J=J+1 :Y=FNXFORM(Y)
  352. 12050 IF ABS(X)> 900 THEN CLOSE:GOTO 12120
  353. 12060 IF ABS(X)>91 THEN GOSUB DRAW.LINE:GOTO 12030
  354. 12070 IF ABS(X-Y(I)) > 20  THEN GOSUB DRAW.LINE:I=0:GOTO 12100
  355. 12080 IF ABS(Y-X(I))>20 AND ABS(X(I))<170 THEN GOSUB DRAW.LINE:I=0:GOTO 12100
  356. 12090 IF ABS(Y-X(I))>20  THEN I=I+1:X(I)=181*SGN(X(I-1)):Y(I)=X:GOSUB DRAW.LINE:Y(1)=X:X(1)=-181*SGN(X(I-1)):I=1
  357. 12100 I=I+1:Y(I)=X:X(I)=Y
  358. 12110 GOTO 12040
  359. 12120 GET (-180,-90)-(179,89) ,NSTORE
  360. 12130 NSEG=VARSEG(NSTORE(0)):NOFF=VARPTR(NSTORE(0))
  361. 12140 DEF SEG=NSEG:BSAVE "MAPPER.SCR",NOFF,&HFDE8:DEF SEG
  362. 12150 RETURN
  363. 13000 LAT.LON.SCRN:
  364. 13010 COLOR 2,0
  365. 13020 XBEGIN=-180:XEND=180:YBEGIN=-90:YEND=90
  366. 13030 CALL SCALE(XBEGIN,XEND,YBEGIN,YEND,XDAT(),YDAT())
  367. 13040 NCOLOR=7:NX.BEGIN=200:NX.END=600:NY.BEGIN=17:NY.END=300:XTIC=30:YTIC=15
  368. 13050 CALL AXES(NCOLOR,NX.BEGIN,NX.END,NY.BEGIN,NY.END,XDAT(),YDAT(),XTIC,YTIC)
  369. 13060 LINE (-179.5,-89.5) -(179.5,89.5),7,B:COLOR 2
  370. 13070 RETURN
  371. 14000 REDRAW:
  372. 14010 GOSUB GET.DATE:GOSUB LAT.LON.SCRN
  373. 14020 CLS:PAINT (0,0),0,7
  374. 14030 GOSUB DRAW.TERMINATOR
  375. 14040 PUT (-180,-90),NSTORE,OR
  376. 14050 GOSUB PAINT.OCEANS
  377. 14060 GOSUB DRAW.LAT.LON
  378. 14070 TIMER ON
  379. 14080 RETURN
  380. 15000 GET.NEW.DATE: 'ENTER NEW DATE AND TIME
  381. 15010 INPUT "Date (MM-DD) ";D$
  382. 15020 INPUT "Time (HH:MM) ";T$
  383. 15030 IF D$="" THEN D$=DATE$
  384. 15040 IF T$="" THEN T$=TIME$
  385. 15050 RETURN
  386. 16000 GET.DATE: D$=DATE$:T$=TIME$
  387. 16010 RETURN
  388. 17000 DRAW.LINE: CALL MYLINE(NCOLOR,X(),Y(),I,XDAT(),YDAT()):COLOR 2:LOCATE 1,1:PRINT "RECORD ";JJ,J;:'A$=INPUT$(1)
  389. 17010 JJ=J:RETURN
  390. 18000 CLEAR.TEXT: FOR J=5 TO 24:LOCATE J,1:PRINT SPACE$(24);:NEXT J:LOCATE 5,1:RETURN
  391. 19000 DELAY:
  392. 19010 FOR KK=1 TO 10000:NEXT KK:RETURN
  393. 20000 PRINT.STRENGTH:
  394. 20010 LOCATE 5,1:COLOR 14
  395. 20020 PRINT "Signal Predictions (dB)":PRINT:PRINT "Freq  Lref  Labs Prcv":PRINT "       Ltx   Lrx  "
  396. 20030 S.COUNT%=0:PR.BEST=-1000:N.BEST=1:NO.PATH%=-1:FOR I=NFREQ TO 1 STEP-1:IF FREQ(I)<1.2*F.MUF AND PR(I)>PR.BEST THEN PR.BEST=PR(I):N.BEST=I
  397. 20035 IF S.COUNT%>=7 THEN 20050
  398. 20040 IF PR(I)>-20 AND FREQ(I)>.8*F.LUF AND FREQ(I)<1.2*F.MUF THEN NO.PATH%=0:S.COUNT%=S.COUNT%+1:PRINT USING "##.# ###.# ###.# #### ";FREQ(I),-REF.LOSS(I),ABSORB.LOSS(I),PR(I)
  399. 20045 IF PR(I)>-20 AND FREQ(I)>.8*F.LUF AND FREQ(I)<1.2*F.MUF THEN NO.PATH%=0:PRINT USING "     ###.# ###.#      ";-TX.LOSS(I),-RX.LOSS(I)
  400. 20050 NEXT I:I=N.BEST
  401. 20054 IF NO.PATH% THEN PRINT USING "##.# ###.# ###.# #### ";FREQ(I),-REF.LOSS(I),ABSORB.LOSS(I),PR(I)
  402. 20056 IF NO.PATH% THEN PRINT USING "     ###.# ###.#      ";-TX.LOSS(I),-RX.LOSS(I)
  403. 20060 IF NO.PATH% THEN PRINT:PRINT "No Feasible Freq"
  404. 20062 IF NO.PATH% THEN PRINT "Best of Bad Lot is Shown"
  405. 20070 RETURN
  406. 35000 SUB REFLECT(ELEV,WAVE.LEN,SEA%,RMAGV,VPHASE,RMAGH,HPHASE,REFLECT.LOSS) STATIC
  407. 35010 'REFLECTION COEFFICIENT CALCULATION
  408. 35020 SHARED CNV,PI
  409. 35030 IF SEA% THEN ER=80:EI=-60*WAVE.LEN*4:DH=4 ELSE ER=15:EI=-60*WAVE.LEN*.01:DH=10
  410. 35040 RHO=EXP(-2*(2*PI*DH*SIN(ELEV/CNV)/WAVE.LEN)^2)
  411. 35050 CA=COS(ELEV/CNV)^2:SA=SIN(ELEV/CNV):SQ1=ER-CA:PQ1=.5*ATN(EI/SQ1):SMAG=SQR(SQ1^2+EI^2)
  412. 35060 SMAG=SQR(SMAG):SQ1=SMAG*COS(PQ1):SQ2=SMAG*SIN(PQ1):
  413. 35070 DENH=(SQR((SA+SQ1)^2+SQ2^2)):PHASE1=SQ2:PHASE2=SA+SQ1:GOSUB 35150:HPHASE=PHASE
  414. 35080 NUMH!=(SQR((SA-SQ1)^2+SQ2^2)):PHASE1=-SQ2:PHASE2=SA-SQ1:GOSUB 35150:HPHASE1=PHASE
  415. 35090 RMAGH=NUMH!/DENH:HPHASE=HPHASE1-HPHASE
  416. 35100 DENV=SQR((SA*ER+SQ1)^2+(EI*SA+SQ2)^2):PHASE1=(EI*SA+SQ2):PHASE2=(ER*SA+SQ1):GOSUB 35150:VPHASE=PHASE
  417. 35110 NUMV!=SQR((SA*ER-SQ1)^2+(EI*SA-SQ2)^2):PHASE1=(EI*SA-SQ2):PHASE2=(ER*SA-SQ1):GOSUB 35150:VPHASE1=PHASE
  418. 35120 RMAGV=NUMV!/DENV:VPHASE=VPHASE1-VPHASE
  419. 35130 REFLECT.LOSS=FNDB(.5*(RMAGH^2+RMAGV^2)*RHO^2)
  420. 35140 EXIT SUB
  421. 35150 '4 QUADRANT ARC TANGENT
  422. 35160 IF PHASE2>0 THEN PHASE=ATN(PHASE1/PHASE2):RETURN
  423. 35170 IF PHASE1<0 THEN PHASE=-PI+ATN(PHASE1/PHASE2) ELSE PHASE=PI+ATN(PHASE1/PHASE2)
  424. 35180 RETURN
  425. 35190 END SUB
  426. 36000 SUB MULTIPATH(ELEV,WAVE.LEN,H.ANTENNA,XMULTV,XMULTH) STATIC
  427. 36010 ' MULTIPATH CALCULATION
  428. 36020 SHARED CNV,PI
  429. 36030 CALL REFLECT(ELEV,WAVE.LEN,0,RMAGV,VPHASE,RMAGH,HPHASE,REFLECT.LOSS)
  430. 36040 ALPHAV=VPHASE-4*PI*H.ANTENNA*SIN(ELEV/CNV)/WAVE.LEN:XMULTV=FNDB((1+RMAGV*COS(ALPHAV))^2+(RMAGV*SIN(ALPHAV))^2)
  431. 36050 ALPHAH=HPHASE-4*PI*H.ANTENNA*SIN(ELEV/CNV)/WAVE.LEN:XMULTH=FNDB((1+RMAGH*COS(ALPHAH))^2+(RMAGH*SIN(ALPHAH))^2)
  432. 36060 XMULT=FNDB(.5*(FNDBI(XMULTV)+FNDBI(XMULTH)))
  433. 36070 END SUB
  434. 39000 SUB MINIMUF(TLAT,TLON,RLAT,RLON,LPATH%,MONTH,DAY,TIME,SSN,NHOPS,EXTRA.HOPS%,F.MUF,F.LUF,E.CUTOFF) STATIC
  435. 39010 WIDTH LPRINT 128
  436. 39020 DIM M$(37),A$(4),M(12)
  437. 39030 SHARED H.TXANT(),H.RXANT(),TX.POL%(),RX.POL%() ,FREQ(),WAVE.LEN(),NFREQ,TX.LOSS(),RX.LOSS(),REF.LOSS(),ABSORB.LOSS(),PT,GT(),GR(),PR(),E.MIN,ELEV
  438. 39040 RE=6364:PI=3.141593: RPD=PI/180: PI2=2*PI: CNV=180/PI: PI.D2=PI/2: X$=STRING$(79,61)
  439. 39045 HEIGHT.F2=300:HEIGHT.E=110:HEIGHT.D=90:POL.LAT=78.3/CNV:POL.LON=69/CNV
  440. 39050 GMT=TIME-TLON/15 :GMT=FNT.MOD(GMT,24)
  441. 39060 T.LAT=TLAT*RPD: T.LON=-TLON*RPD: R.LAT=RLAT*RPD: R.LON=-RLON*RPD:
  442. 39070 PHI=CNV*FNASIN(RE*COS(E.MIN/CNV)/(RE+HEIGHT.F2)):TH=180-PHI-90-E.MIN:GR.MAX=2*TH*RE/CNV
  443. 39080 GOSUB 40000 :REM   TO MAIN CALCULATION LOOP
  444. 39090 EXIT SUB
  445. 40000 REM   MINIMUF 4.1 CALCULATION LOOP
  446. 40010 COS.GRNG=SIN(T.LAT)*SIN(R.LAT)+COS(T.LAT)*COS(R.LAT)*COS(R.LON-T.LON)
  447. 40020 GRNG=FNACOS(COS.GRNG) :IF LPATH% THEN GRNG=2*PI-GRNG
  448. 40030 MIN.NHOPS=1+FIX(RE*GRNG/GR.MAX) 'NUMBER OF 3500 KM HOPS
  449. 40035 NHOPS=MIN.NHOPS+EXTRA.HOPS%
  450. 40040 HOP.INV=1!/NHOPS
  451. 40050 F.MUF=100:E.CUTOFF=0:F.LUF=0
  452. 40060 ANG=.5*GRNG/CSNG(NHOPS):R.SLANT=SQR(RE^2+(RE+HEIGHT.F2)^2-2*RE*(RE+HEIGHT.F2)*COS(ANG))
  453. 40070 ELEV=CNV*FNACOS((RE+HEIGHT.F2)*SIN(ANG)/R.SLANT)
  454. 40080 PHID=CNV*FNASIN(RE*COS(ELEV/CNV)/(RE+HEIGHT.D)) ' INCIDENCE ANGLE ON D LAYER AT 90 KM
  455. 40090 PATH.LOSS=2*FNDB(4*PI*R.SLANT*2*NHOPS*1000)
  456. 40100 ANG=GRNG/(1+NHOPS):EL.MAX=ATN(1/TAN(ANG)-(RE/(RE+HEIGHT.F2))/SIN(ANG)):IF EL.MAX<18/CNV THEN EL.MAX=18/CNV
  457. 40110 SEC.EINC= 1/SQR(1-( (RE/(RE+HEIGHT.E)) *COS(EL.MAX) )^2)
  458. 40120 FOR I=1 TO NFREQ
  459. 40130 CALL MULTIPATH(ELEV,WAVE.LEN(I),H.TXANT(I),XMULTV,XMULTH):IF TX.POL%(I) THEN TX.LOSS(I)=XMULTV ELSE TX.LOSS(I)=XMULTH
  460. 40140 CALL MULTIPATH(ELEV,WAVE.LEN(I),H.RXANT(I),XMULTV,XMULTH):IF RX.POL%(I) THEN RX.LOSS(I)=XMULTV ELSE RX.LOSS(I)=XMULTH
  461. 40150 REF.LOSS(I)=0:ABSORB.LOSS(I)=0:NEXT I
  462. 40160 FOR KHOP=1 TO NHOPS:PATH.FRAC=(KHOP-.5)/NHOPS:
  463. 40170 REFL.PATH.FRAC=CSNG(KHOP-1!)/NHOPS
  464. 40180 SIN.RLAT=SIN(R.LAT)
  465. 40190 COS.RLAT=COS(R.LAT)
  466. 40200 COS.RAZIM=(SIN(T.LAT)-SIN.RLAT*COS(GRNG))/(COS.RLAT*SIN(GRNG))
  467. 40210 CTRL.RNG=GRNG*PATH.FRAC  :REFL.RNG=GRNG*REFL.PATH.FRAC
  468. 40220 SIN.CLAT=SIN.RLAT*COS(CTRL.RNG)+COS.RLAT*SIN(CTRL.RNG)*COS.RAZIM
  469. 40230 SIN.RFLAT=SIN.RLAT*COS(REFL.RNG)+COS.RLAT*SIN(REFL.RNG)*COS.RAZIM
  470. 40240 COS.CLON=(COS(CTRL.RNG)-SIN.CLAT*SIN.RLAT)/(COS.RLAT*SQR(1-SIN.CLAT^2))
  471. 40250 COS.RFLON=(COS(REFL.RNG)-SIN.RFLAT*SIN.RLAT)/(COS.RLAT*SQR(1-SIN.RFLAT^2))
  472. 40260 CLON=FNACOS(COS.CLON) :RFLON=FNACOS(COS.RFLON)
  473. 40270 C.LON=R.LON+SGN(SIN(T.LON-R.LON))*CLON
  474. 40280 IF C.LON<0 THEN C.LON=C.LON+PI2
  475. 40290 IF C.LON>=PI2 THEN C.LON=C.LON-PI2
  476. 40300 C.LAT=PI.D2-FNACOS(SIN.CLAT)
  477. 40310 RF.LON=R.LON+SGN(SIN(T.LON-R.LON))*RFLON
  478. 40320 IF RF.LON<0 THEN RF.LON=RF.LON+PI2
  479. 40330 IF RF.LON>=PI2 THEN RF.LON=RF.LON-PI2
  480. 40340 RF.LAT=(PI.D2-FNACOS(SIN.RFLAT))*CNV:RFL=CNV*RF.LON:RF.LON=FNXFORM(-CNV*RF.LON):IF REFL.PATH.FRAC=0 THEN 40380
  481. 40350 IF POINT(RF.LON,RF.LAT) =1 THEN SEA%=-1 ELSE SEA%=0
  482. 40360 FOR I=1 TO NFREQ:CALL REFLECT(ELEV,WAVE.LEN(I),SEA%,RMV,VP,RMH,HP,REFLECT.LOSS)
  483. 40370 REF.LOSS(I)=REF.LOSS(I)+REFLECT.LOSS:NEXT I
  484. 40380 YR.ANGLE=.0172*(10+(MONTH-1)*30.4+DAY)
  485. 40390 TILT.ANGLE=.409*COS(YR.ANGLE) :COSX1=-1:COSX2=-1:COSX3=-1
  486. 40400 T.NOON=3.82*C.LON+12+.13*(SIN(YR.ANGLE)+1.2*SIN(2*YR.ANGLE))
  487. 40410 T.NOON=FNT.MOD(T.NOON,24)
  488. 40420 IF COS(C.LAT+TILT.ANGLE)>-.26 THEN GOTO SUN.LIGHT
  489. 40430 T.SUN=0
  490. 40440 COSX=0
  491. 40450 M.FACT!=2.5*GRNG*HOP.INV
  492. 40460 IF M.FACT!>PI.D2 THEN M.FACT!=PI.D2
  493. 40470 M.FACT!=SIN(M.FACT!)
  494. 40480 M.FACT!=1+2.5*M.FACT!*SQR(M.FACT!)
  495. 40490 GOTO MUF.CALC
  496. 40500 SUN.LIGHT:
  497. 40510 T.SUN=(-.26+SIN(TILT.ANGLE)*SIN(C.LAT))/(COS(TILT.ANGLE)*COS(C.LAT)+9.999999E-04)
  498. 40520 T.SUN=12-ATN(T.SUN/SQR(ABS(1-T.SUN*T.SUN)))*7.639437
  499. 40530 T.RISE=T.NOON-T.SUN/2+12*(1-SGN(T.NOON-T.SUN/2))*SGN(ABS(T.NOON-T.SUN/2))
  500. 40540 T.SET=T.NOON+T.SUN/2-12*(1+SGN(T.NOON+T.SUN/2-24))*SGN(ABS(T.NOON+T.SUN/2-24))
  501. 40550 COS.ZEN=ABS(COS(C.LAT+TILT.ANGLE))
  502. 40560 T.RELAX=9.7*COS.ZEN^9.600001
  503. 40570 IF T.RELAX <.1 THEN T.RELAX=.1
  504. 40580 M.FACT!=2.5*GRNG*HOP.INV
  505. 40590 IF M.FACT!>PI.D2 THEN M.FACT!=PI.D2
  506. 40600 M.FACT!=SIN(M.FACT!)
  507. 40610 M.FACT!=1+2.5*M.FACT!*SQR(M.FACT!)
  508. 40620 IF T.SET<T.RISE THEN GOTO CHECK.TIME
  509. 40630 IF (GMT-T.RISE)*(T.SET-GMT)>0 THEN GOTO DAY.TIME
  510. 40800 NITE.TIME:
  511. 40810 GMT0=GMT+12*(1+SGN(T.SET-GMT))*SGN(ABS(T.SET-GMT))
  512. 40820 U0=PI*T.RELAX/T.SUN
  513. 40830 U=(T.SET-GMT0)/2
  514. 40840 U1=-T.SUN/T.RELAX
  515. 40850 FRAC.SUN=PI*(GMT0-T.SET)/(24-T.SUN)
  516. 40860 COSX=COS.ZEN*(U0*(EXP(U1)+1))*EXP(U)/(1+U0*U0):COSX1=COSX
  517. 40870 FRAC.SUN=0
  518. 40880 GOTO MUF.CALC
  519. 40900 CHECK.TIME:
  520. 40910 IF (GMT-T.SET)*(T.RISE-GMT)>0 THEN GOTO NITE.TIME
  521. 41000 DAY.TIME:
  522. 41010 GMT0=GMT+12*(1+SGN(T.RISE-GMT))*SGN(ABS(T.RISE-GMT))
  523. 41020 TAU0=PI*(GMT0-T.RISE)/T.SUN
  524. 41030 U0=PI*T.RELAX/T.SUN
  525. 41040 U=(T.RISE-GMT0)/T.RELAX
  526. 41050 FRAC.SUN=PI*(GMT0-T.RISE)/T.SUN
  527. 41060 COSX=COS.ZEN*(SIN(TAU0)+U0*(EXP(U)-COS(TAU0)))/(1+U0*U0) :COSX2=COSX
  528. 41070 ALT.COSX=COS.ZEN*(U0*(EXP(-T.SUN/T.RELAX)+1))*EXP((T.SUN-24)/2)/(1+U0*U0):COSX3=ALT.COSX
  529. 41080 IF COSX=>ALT.COSX THEN GOTO MUF.CALC
  530. 41090 COSX=ALT.COSX
  531. 42000 MUF.CALC:
  532. 42010 MUF!=(1+SSN/250)*SQR(6+58*SQR(COSX))
  533. 42020 FVERT=MUF!
  534. 42030 MUF!=MUF!*(1-.1*EXP((T.SUN-24)/3))
  535. 42040 MUF!=MUF!*(1+(1-SGN(T.LAT)*SGN(R.LAT))*.1)
  536. 42050 MUF!=MUF!*(1-.1*(1+SGN(ABS(SIN(C.LAT))-COS(C.LAT))))
  537. 42060 FVERT1=MUF!:MUF!=M.FACT!*MUF!:
  538. 43000 IF MUF!<F.MUF THEN F.MUF=MUF!
  539. 43010 GOSUB ECUTOFF:GOSUB D.LOSS:GOSUB SIGNAL.STRENGTH:
  540. 43020 'GOSUB PRINT.STUFF
  541. 43030 NEXT KHOP
  542. 43040 RETURN
  543. 45000 ECUTOFF: 'CALCULATE E LAYER CUTOFF FREQ
  544. 45010 E.FACT=.2:IF T.SUN=0 THEN GOTO ESCREEN
  545. 45020 IF T.SUN*FRAC.SUN=0  THEN GOTO ESCREEN
  546. 45030 E.COSX=COS.ZEN*SIN(PI*(GMT0-T.RISE)/T.SUN)
  547. 45040 IF E.COSX >.174 THEN E.FACT=E.COSX^.3 ELSE E.FACT=(FNACOS(E.COSX)*CNV-76)^-.4
  548. 45050 ESCREEN:
  549. 45060 E.SCREEN=(3.4+.00544*SSN)*E.FACT*SEC.EINC
  550. 45070 IF E.SCREEN>7 THEN E.LUF=(1.33*E.SCREEN-3.31)^2/7 ELSE E.LUF=.91*E.SCREEN -.37
  551. 45080 IF F.LUF<E.LUF THEN F.LUF=E.LUF
  552. 45090 IF E.CUTOFF<E.SCREEN THEN E.CUTOFF=E.SCREEN
  553. 45100 RETURN
  554. 46000 D.LOSS: ' CALCULATE D REGION ABSORPTION
  555. 46002 MAG.LAT!=FNASIN( COS(POL.LAT)*COS(C.LAT)*COS(POL.LON-C.LON)+SIN(POL.LAT)*SIN(C.LAT))
  556. 46004 F.GYRO=.8*SQR(1+3*SIN(MAG.LAT!)^2)
  557. 46010 CHI=CNV*FNACOS(COS.ZEN*SIN(PI*(GMT0-T.RISE)/T.SUN))
  558. 46020 IF CHI < 102 THEN XLOSS=1.5*430*(1+.0035*SSN)*COS(.881*CHI/CNV)^.75/(COS(PHID/CNV))  ELSE XLOSS=0
  559. 46025 IF CHI<102 THEN XINDEX=(1+.0037*SSN)*COS(.881*CHI/CNV)^1.3 ELSE XINDEX=0
  560. 46026 IF XINDEX<.1 THEN XINDEX=.1
  561. 46027 XLOSS=677.2*XINDEX/(COS(PHID/CNV))
  562. 46030 FOR I=1 TO NFREQ:ABSORB.LOSS(I)=ABSORB.LOSS(I)+XLOSS/((FREQ(I)+F.GYRO)^2+10.2) :NEXT I
  563. 46040 RETURN
  564. 46500 SIGNAL.STRENGTH: 'CALCULATE SIGNAL STRENGTH
  565. 46510 FOR I=1 TO NFREQ
  566. 46520 PR(I)=FNDB(PT)+GT(I)+TX.LOSS(I)+GR(I)+RX.LOSS(I)+REF.LOSS(I)-ABSORB.LOSS(I)+2*FNDB(WAVE.LEN(I))-PATH.LOSS
  567. 46530 PR(I)=PR(I)-FNDB(.0000005^2/50)
  568. 46540 NEXT I:RETURN
  569. 47000 PRINT.STUFF:
  570. 47010 LPRINT USING "KHOP = ### GMT= ###  Fv=#####.# Fv1=#####.# Mf= ##.### MUF= #####.# ";KHOP,GMT,FVERT,FVERT1,M.FACT!,MUF!
  571. 47020 LPRINT USING "           E.SCREEN=#####.# E.LUF=#####.# E.CUTOFF=#####.# F.LUF= #####.# ";E.SCREEN,E.LUF,E.CUTOFF,F.LUF
  572. 47030 LPRINT USING "     C.LAT=####.#  C.LON=####.# YR.ANGLE=####.# TILT.ANGLE=####.# COS.ZEN=##.###";C.LAT*CNV,C.LON*CNV ,YR.ANGLE*CNV,TILT.ANGLE*CNV,COS.ZEN
  573. 47040 LPRINT USING "     R.LAT=####.#  R.LON=####.# ELEV=####.# PHID=####.# R.SLANT=##### PATH.LOSS=####.#";RF.LAT,RFL,ELEV,PHID,R.SLANT,PATH.LOSS
  574. 47050 FOR I=1 TO NFREQ
  575. 47060 LPRINT USING "     F= ###.# TX.LOSS=###.# RX.LOSS=###.# REF.LOSS=###.# ABSORB=###.# PR= ###.#  ###";FREQ(I),TX.LOSS(I),RX.LOSS(I),REF.LOSS(I),ABSORB.LOSS(I),PR(I),SEA%
  576. 47070 NEXT I
  577. 47080 LPRINT "":RETURN
  578. 47090 LPRINT USING "     T.NOON=###.# T.SUN=###.# T.RISE=###.# T.SET=###.# T.RELAX=###.# ";T.NOON,T.SUN,T.RISE,T.SET,T.RELAX
  579. 47100 LPRINT USING "     COSX=###.##     COSX1=###.## COSX2=###.## COSX3=###.##";COSX,COSX1,COSX2,COSX3
  580. 47110 LPRINT USING "     TLAT=###.# TLON=###.# RLAT=###.# RLON=###.# GRNG=##### SSN=#### ";TLAT,TLON,RLAT,RLON,RE*GRNG,SSN
  581. 47120 LPRINT "":RETURN
  582. 48000 REM   CALCULATION OF SUNSPOT NUMBER FROM SOLAR FLUX
  583. 48010 SSN=-103.7767+1.797429*SF-(3.384356E-03)*SF^2+(4.525515E-06)*SF^3
  584. 48020 SSN=INT(100*SSN+.5)/100
  585. 48030 RETURN
  586. 50000 END SUB
  587. 51000 '    VIDEO GRAPHICS FOR QUICK BASIC
  588. 51010 '    EMULATION OF CALCOMP ROUTINES
  589. 51020 '
  590. 52000 SUB  SCALE(XBEGIN,XEND,YBEGIN,YEND,XDAT(1),YDAT(1)) STATIC
  591. 52010 '    SCALING ROUTINE TO SCALE PLOTS TO THE UNITS OF
  592. 52020 '    THE DATA TO BE PLOTTED
  593. 52030      WINDOW (XBEGIN,YBEGIN)-(XEND,YEND)
  594. 52040      XDAT(1)=XEND-XBEGIN:YDAT(1)=YEND-YBEGIN
  595. 52050      XDAT(2)=XBEGIN:YDAT(2)=YBEGIN
  596. 52060      XDAT(3)=XEND:YDAT(3)=YEND
  597. 52070 END  SUB
  598. 52080 '
  599. 53000 SUB  AXES(NCOLOR,NX.BEGIN,NX.END,NY.BEGIN,NY.END,XDAT(1),YDAT(1),XTIC,YTIC) STATIC
  600. 53010 '    DRAW BOX WITH AXES AND TIC MARKS
  601. 53020 '    NX..,NY.. ARE DOT VALUES WHICH DEFINE THE BEGINNING & END
  602. 53030 '    OF EACH AXIS IN VIDEO DOT UNITS 0<=DX<=639, 0<=DY<=349
  603. 53040 '    Y VALUES ARE DEFINED WITH 0 AT BOTTOM OF SCREEN.
  604. 53050 '    XTIC,YTIC ARE THE TIC SPACINGS IN UNITS OF THE DATA TO BE
  605. 53060 '    PLOTTED VIA SCALE AND MYLINE. XDAT AND YDAT ARE SCALING DATA IN
  606. 53070 '    SAME UNITS FROM SCALE ROUTINE.
  607. 53080 '    NCOLOR IS THE FOREGROUND COLOR
  608. 53090      DEFINT I-N :COLOR NCOLOR
  609. 53100      IF NX.BEGIN <0 THEN NX.BEGIN=0 ELSE IF NX.BEGIN > 639  THEN NX.BEGIN=639
  610. 53110      IF NX.END   <0 THEN NX.END  =0 ELSE IF NX.END   > 639  THEN NX.END  =639
  611. 53120      IF NY.BEGIN <0 THEN NY.BEGIN=0 ELSE IF NY.BEGIN > 349  THEN NY.BEGIN=349
  612. 53130      IF NY.END   <0 THEN NY.END  =0 ELSE IF NY.END   > 349  THEN NY.END  =349
  613. 53140      VIEW (NX.BEGIN,349-NY.BEGIN)-(NX.END,349-NY.END),,NCOLOR
  614. 53150      DY.TIC=.01*ABS(XDAT(1)):DX.TIC=.01*ABS(YDAT(1))
  615. 53160      FOR X=XDAT(2) TO XDAT(3) STEP XTIC
  616. 53170           LINE (X,YDAT(2))- STEP (0, DX.TIC)
  617. 53180           LINE (X,YDAT(3))- STEP (0,-DX.TIC)
  618. 53190      NEXT X
  619. 53200      FOR Y=YDAT(2) TO YDAT(3) STEP YTIC
  620. 53210           LINE (XDAT(2),Y)- STEP ( DY.TIC,0)
  621. 53220           LINE (XDAT(3),Y)- STEP (-DY.TIC,0)
  622. 53230      NEXT Y
  623. 53240 END  SUB
  624. 53250 '
  625. 54000 SUB  MYLINE(NCOLOR,X(1),Y(1),NPTS,XDAT(1),YDAT(1)) STATIC
  626. 54010      DEFINT I-N
  627. 54020      FOR I=2 TO NPTS
  628. 54030           IF ABS( X(I)-X(I-1) ) >.3*XDAT(1) OR ABS( Y(I)-Y(I-1) ) >.3*YDAT(1) THEN 54050
  629. 54040           LINE (X(I-1),Y(I-1))-(X(I),Y(I)),NCOLOR
  630. 54050      NEXT I
  631. 54060 END  SUB
  632. 55000 SUB  UPPER.CASE(A$) STATIC
  633. 55010      L=LEN(A$):IF L=0 THEN EXIT SUB
  634. 55020      FOR I=1 TO L
  635. 55030          K=ASC(MID$(A$,I,1))
  636. 55040          IF K>=97 AND K<=122 THEN MID$(A$,I,1)=CHR$(K-32)
  637. 55050      NEXT I
  638. 55060 END  SUB
  639.